José es un diseñador de juegos de mesa. Crea las reglas, diseña los gráficos, escoge su tema, número de jugadores y duración promedio del juego que tiene en mente. José es una persona tímida, y a pesar de que sus juegos suelen gustarle a sus amigos, él nunca ha querido publicarlos por miedo a que no sean bien recibidos. Se quiere demostrar a José, con una base de datos de calificaciones históricas de juegos de mesa, cómo hubieran sido recibidos sus juegos en promedio en la época que los fue creando.
Los datos a utilizar vienen de esta base de datos: (board_games)* que, en cambio, vienen de la página Board Game Geek.
Procedemos para empezar en instalar los siguientes paquetes, se puede omitir este paso si ya se tienen previamente instalados. Aquí una lista de los cuales vamos a necesitar.
#install.packages("data.table")
#install.packages("h2o")
#install.packages("ggplot2")
#install.packages("ggthemes")
#install.packages("data.tree")
#install.packages("tidyverse")
#install.packages("modeldata")
#install.packages("DataExplorer")
#install.packages("vtree")
#install.packages("caTools")
#install.packages("rpart")
#install.packages("rpart.plot")
#install.packages("lares")Usando ‘library’ cargamos las librerías, con las cuales vas a hacer uso de las diferentes funciones.
library("data.table")data.table 1.14.0 using 6 threads (see ?getDTthreads). Latest news: r-datatable.com
Attaching package: 㤼㸱data.table㤼㸲
The following objects are masked from 㤼㸱package:dplyr㤼㸲:
between, first, last
The following object is masked from 㤼㸱package:purrr㤼㸲:
transpose
library("h2o")
----------------------------------------------------------------------
Your next step is to start H2O:
> h2o.init()
For H2O package documentation, ask for help:
> ??h2o
After starting H2O, you can use the Web UI at http://localhost:54321
For more information visit https://docs.h2o.ai
----------------------------------------------------------------------
Attaching package: 㤼㸱h2o㤼㸲
The following objects are masked from 㤼㸱package:data.table㤼㸲:
hour, month, week, year
The following objects are masked from 㤼㸱package:stats㤼㸲:
cor, sd, var
The following objects are masked from 㤼㸱package:base㤼㸲:
%*%, %in%, &&, ||, apply, as.factor, as.numeric, colnames, colnames<-, ifelse, is.character, is.factor, is.numeric, log, log10, log1p, log2, round, signif, trunc
library("ggplot2")
library("ggthemes")
library("data.tree")
library("tidyverse")
library("modeldata")
library("DataExplorer")
library("vtree")
library("caTools")
library("rpart")
library("rpart.plot")
library("lares")En este caso usamos read.csv. Procedemos a leer:
board_games <- read.csv("./board_games.csv") head(board_games)Después de una rápida observación, ejecutamos los siguientes comandos para confirmación:
colnames(board_games) [1] "game_id" "description" "image" "max_players" "max_playtime" "min_age" "min_players" "min_playtime" "name" "playing_time" "thumbnail"
[12] "year_published" "artist" "category" "compilation" "designer" "expansion" "family" "mechanic" "publisher" "average_rating" "users_rated"
Usando data explorer observamos el tipo de variables, casi tenemos el mismo porcentaje para las discretas y continua, y tenemos un bajo porcentaje de missing values:
Estos valores faltantes nos podrán general problemas para analizar los datos, veamos un poco los perfiles que faltan.
plot_intro(board_games)Para visualizar el perfil de los datos faltantes podemos utilizar la función plot_missing(). En la visualización debajo, podemos ver que la variables compilation y expansion, son las que les falta información, encontramos de que sólo el 2.63% (compilation), 16.54% (expansion) de nuestras filas estén completas y probablemente esta varible no sea de mucha infomación. Por tanto la podemos eliminar de nuestro dataframe, ahorita mismo!!
plot_missing(board_games)Eliminamos compilation y expansion de nuestro dataframe:
final_board_games <- drop_columns(board_games, c("description", "image", "name", "thumbnail", "game_id", "compilation","expansion", "family", "artist", "mechanic"))
final_board_games <- drop_columns(final_board_games, c("designer", "publisher"))
colnames(final_board_games) [1] "max_players" "max_playtime" "min_age" "min_players" "min_playtime" "playing_time" "year_published" "category" "average_rating" "users_rated"
final_board_games <- na.omit(final_board_games) Podemos ver la más alta correlación en estas variables:
plot_correlation(na.omit(final_board_games), maxcat = 5L)Ignored all discrete features since `maxcat` set to 5 categories!
Ahora de una manera más detallada vamos a analizar las variables más correlacionadas entre sí. El top 10:
corr_cross(final_board_games, # name of dataset
max_pvalue = 0.05, # display only significant correlations (at 5% level)
top = 10 # display top 10 couples of variables (by correlation coefficient)
)Returning only the top 10. You may override with the 'top' argument
La gráfica Quantile-Quantile es una forma de visualizar la desvisión de una distribución de probabilidad específica.
Después de analizar estos gráficos, a menudo es beneficioso aplicar una transformación matemática (como logaritmo) para modelos como la regresión lineal. Para hacerlo, podemos usar la función plot_qq. De forma predeterminada, se compara con la distribución normal.
qq_data <- final_board_games[, c("min_playtime", "max_playtime", "min_age", "playing_time", "average_rating")]
plot_qq(qq_data, sampled_rows = 1000L)En el gráfico, las columnas parecen sesgadas en ambas colas. Apliquemos una transformación logarítmica simple y grafiquemos de nuevo.
log_qq_data <- update_columns(qq_data, 1:5, function(x) log(x + 1))
plot_qq(log_qq_data, sampled_rows = 1000L)Teniendo nuestras variables con mayor correlación vamos a graficarlas con geom point..:
final_board_games %>% ggplot(aes(x = min_playtime, y = min_age)) +
geom_point()final_board_games %>% ggplot(aes(x = average_rating, y = min_age)) +
geom_point()final_board_games %>% ggplot(aes(x = playing_time, y = average_rating)) +
geom_point()final_board_games %>% ggplot(aes(x = users_rated, y = average_rating)) +
geom_point()###Using vtree para explorar
Usamos vtree para observar la concentración de los datos por ejemplo para min_age, donde la mayoría de los datos se concentran en min_age de 8 años, 10 años y 12 años.
vtree(final_board_games, "min_age")Usamos vtree para observar la concentración de los datos por ejemplo para min_players, tenemos casi un 69% para min 2 jugadores y cerca del 19% para min 3 jugadores.
vtree(final_board_games, "min_players")Usamos vtree para observar la concentración de los datos por ejemplo para max_players, tenemos casi un 23% para máx 4 jugadores y cerca del 25% para máx 6 jugadores.
vtree(final_board_games, "max_players")Se realizó una exploración de datos, donde primero eliminalos columnas que no tienen mucha significancia en la predicción de nuestra variable de calificación. Después vimos su correlación entre las existentes.
Se tiene más claro cuales son las variables más significativas a la predicción, se hizo una limpieza, tenemos datos más contundentes con los cuales comenzar nuestra predicción, menos outliers sobre todo.
Debido a que el problema intenta convencer a José de que sus juegos pudieron haber sido (en promedio) bien recibidos, y de cómo se espera que se reciban en un futuro, la variable de salida de nuestro problema es la calificación de los usuarios del sitio web. Esto puede hacerse de dos maneras: una regresión y tomar la calificación como una variable continua, o redondear y tomarlo como problema de clasificación (calificación discreta de 0 a 10). Las propuestas para estos casos son
Vamos a suponer que a la comunidad de juegos de mesa no les importa tanto el historial del autor del juego ni quién lo publique, por lo que esas columnas se eliminarían del análisis. Si José ve que sus juegos no hubieran gustado, al menos podrá tener un modelo con el cuál puede saber qué es lo que suele gustarle a la gente, por lo que podría hacer investigación de seguimiento para entablar las causas raíces.
Primero hacemos la separación de los datos en train y test. Todos los modelos usarán los mismos subconjuntos para poder evaluarlos y compararlos en un terreno nivelado.
library(caTools)
set.seed(0)
split = sample.split(final_board_games, SplitRatio=0.6)
data.train = subset(final_board_games, split=TRUE)
data.test = subset(final_board_games, split=FALSE)library(caret)
library(doParallel)
set.seed(0)
control = trainControl(method="repeatedcv", repeats=5, search="random")
registerDoParallel(cores = parallel::detectCores() - 1)
model.svr = train(average_rating ~ ., data = drop_columns(data.train, "category"),
method = "svmRadial",
tuneLength = 15,
metric = "RMSE",
preProc = c("center", "scale"),
trControl = control)
model.svrSupport Vector Machines with Radial Basis Function Kernel
1200 samples
8 predictor
Pre-processing: centered (8), scaled (8)
Resampling: Cross-Validated (10 fold, repeated 5 times)
Summary of sample sizes: 1080, 1080, 1080, 1080, 1080, 1080, ...
Resampling results across tuning parameters:
sigma C RMSE Rsquared MAE
0.01226831 45.77096245 0.5971698 0.28603519 0.4569200
0.01450086 432.22566749 0.6077075 0.27828915 0.4600209
0.01733709 0.08424009 0.6385926 0.22166352 0.4933061
0.01797172 0.68418148 0.6089168 0.26137934 0.4676323
0.01949306 53.19382628 0.5923793 0.29802023 0.4532379
0.03197837 97.46893089 0.6050052 0.27990795 0.4595333
0.04891373 0.09331815 0.6188100 0.25343570 0.4756074
0.08517855 1.13103822 0.5900931 0.30271546 0.4517433
0.09135066 15.15147202 0.5944384 0.29497671 0.4532882
0.45152266 986.00398192 1.0261372 0.09002466 0.6915994
0.61653904 0.15882372 0.6108620 0.26636552 0.4694599
1.29998370 10.85267954 0.6525816 0.20588346 0.5030971
1.34663993 0.16233196 0.6224801 0.24125207 0.4783713
1.35594685 0.51325259 0.6090114 0.25717566 0.4658292
4.87616608 0.47422243 0.6315189 0.20311225 0.4874107
RMSE was used to select the optimal model using the smallest value.
The final values used for the model were sigma = 0.08517855 and C = 1.131038.
library(h2o)
h2o.init()
H2O is not running yet, starting it now...
Note: In case of errors look at the following log files:
C:\Users\Gabo\AppData\Local\Temp\RtmpI1Kjjj\file47301fbd70e6/h2o_Gabo_started_from_r.out
C:\Users\Gabo\AppData\Local\Temp\RtmpI1Kjjj\file47306eea607/h2o_Gabo_started_from_r.err
java version "15.0.1" 2020-10-20
Java(TM) SE Runtime Environment (build 15.0.1+9-18)
Java HotSpot(TM) 64-Bit Server VM (build 15.0.1+9-18, mixed mode, sharing)
Starting H2O JVM and connecting: Connection successful!
R is connected to the H2O cluster:
H2O cluster uptime: 1 seconds 994 milliseconds
H2O cluster timezone: America/Mexico_City
H2O data parsing timezone: UTC
H2O cluster version: 3.32.1.3
H2O cluster version age: 1 month and 20 days
H2O cluster name: H2O_started_from_R_Gabo_ljy373
H2O cluster total nodes: 1
H2O cluster total memory: 3.98 GB
H2O cluster total cores: 12
H2O cluster allowed cores: 12
H2O cluster healthy: TRUE
H2O Connection ip: localhost
H2O Connection port: 54321
H2O Connection proxy: NA
H2O Internal Security: FALSE
H2O API Extensions: Amazon S3, Algos, AutoML, Core V3, TargetEncoder, Core V4
R Version: R version 4.1.0 (2021-05-18)
data.h2o.train = as.h2o(data.train)
|
| | 0%
|
|==================================================================================================================================================================================================| 100%
data.h2o.test = as.h2o(data.test)
|
| | 0%
|
|==================================================================================================================================================================================================| 100%
model.h2o.rf = h2o.randomForest(
training_frame = data.h2o.train,
validation_frame = data.h2o.test,
x = c(1, 2, 3, 4, 5, 6, 7, 8, 10),
y = 9,
model_id = "rf_covType_v1",
ntrees = 200,
stopping_rounds = 2,
score_each_iteration = T,
seed = 26
)Dropping bad and constant columns: [category].
|
| | 0%
|
|==================================================================================================================================================================================================| 100%
summary(model.h2o.rf)Model Details:
==============
H2ORegressionModel: drf
Model Key: rf_covType_v1
Model Summary:
H2ORegressionMetrics: drf
** Reported on training data. **
** Metrics reported on Out-Of-Bag training samples **
MSE: 0.3763041
RMSE: 0.6134363
MAE: 0.4666793
RMSLE: 0.08950471
Mean Residual Deviance : 0.3763041
H2ORegressionMetrics: drf
** Reported on validation data. **
MSE: 0.07822108
RMSE: 0.2796803
MAE: 0.2091356
RMSLE: 0.04187238
Mean Residual Deviance : 0.07822108
Scoring History:
---
Variable Importances: (Extract with `h2o.varimp`)
=================================================
Variable Importances:
library(tidymodels)
data.train.discrete = data.train %>% mutate(discrete_rating = round(average_rating)) %>% drop_columns("average_rating")
data.test.discrete = data.test %>% mutate(discrete_rating = round(average_rating)) %>% drop_columns("average_rating")
rf = rand_forest(
mode = "classification",
trees = tune(),
min_n = tune()
) %>% set_engine(engine = "randomForest")
transformer = recipe(
formula = discrete_rating ~ .,
data = data.train.discrete
)
cv_folds = vfold_cv(
data = data.train.discrete,
v = 5,
strata = discrete_rating
)
workflow_modelado = workflow() %>%
add_recipe(transformer) %>%
add_model(rf)
hp_grid = grid_regular(
trees(range = c(50L, 3000L), trans = NULL),
min_n(range = c(2L, 100L), trans = NULL),
levels = 5
)
registerDoParallel(cores = parallel::detectCores() - 1)
grid_fit = tune_bayes(
workflow_modelado,
resamples = cv_folds,
initial = 20,
iter = 30,
control = control_bayes(no_improve = 20, verbose = FALSE)
)All models failed. See the `.notes` column.Error: All of the models failed. See the .notes column.
Run `rlang::last_error()` to see where the error occurred.